DefInt A-Z
Dim Record As RecFmt
Dim Pointer(32000)
'Rather than move Records around in a file, we use pointers to the records
'instead.

Dim Deleted(32000), NumDeleted
'Again, rather than move data around when when a record is deleted,
'we keep track of deleted records and reuse them when adding new records.

Dim GridStart  'pointer number of the first Record on the grid
Dim CurRec      'pointer number of the last Record found on a search
Dim LastRecord  'number of Records in the File: 5000, in this example
Dim FileSorted  'flag to show if the File Pointers are sorted.
Dim PgAmt        'number of lines to page up and down by
Dim Bottom(10), Topp(10)   'variables used in the sort routine.
Dim LastValue  'last value selected on scroll bar
Dim IgnoreChange  'flag to allow changing Vscroll1.value without executing
                  'Vscroll1.Change
Dim MatchRow 'Grid row number where matching item is after a Find
'Copyright 1991 Nelson Ford, Public (software) Library, 713-524-6394

Sub Form_Load ()
  Form1.Show
  MousePointer = 11
  FileSize = 6000   'maximum number of records allowed

  LastRecord = 5000 'number of records in the test file
  Open "c:\vb\test" For Random As 1 Len = 24
  If LOF(1) < 120000 Then Call MakeSampleFile
  For i = 1 To 5000
    Pointer(i) = i
  Next
  
  'Set width of each grid column:
  Grid1.Col = 0: Grid1.Colwidth = 1200
  Grid1.Col = 1: Grid1.Colwidth = 1400
  Grid1.Col = 2: Grid1.Colwidth = 1600

  'Set up Scroll bar values:
  Vscroll1.Max = LastRecord
  Vscroll1.Min = 1
  Vscroll1.LargeChange = Grid1.Rows - 1
  Vscroll1.SmallChange = 1: IgnoreChange = -1
  Vscroll1.Value = LastRecord: IgnoreChange = 0
  LastValue = LastRecord


  'display last 10 entries in the Grid:
  GridStart = LastRecord - 9
  Call FillGrid(GridStart, LastRecord, 0)
  Grid1.Row = 0
  Grid1.Col = 0
  Grid1.SelStartRow = 0
  Grid1.SelStartCol = 0
  
  T_Input.SetFocus
  MousePointer = 0
End Sub

Sub FillGrid (StartPt, StopPt, StartRow)
  For i = StartPt To StopPt
    Get 1, Pointer(i), Record
    Grid1.Row = i - StartPt + StartRow
    Grid1.Col = 0
    Grid1.Text = Record.a1
    Grid1.Col = 1
    Grid1.Text = Record.a2
    Grid1.Col = 2
    Grid1.Text = Record.a3
  Next
End Sub

Sub Vscroll1_Change ()  'See "Change Property" in the VB Manual.
'Stop
  If IgnoreChange Then Exit Sub
  If Vscroll1.Value = LastValue - 1 Then 'up arrow clicked: scroll down
    GridStart = GridStart - 1
    Call ScrollDown(1, 9)
    Call FillGrid(GridStart, GridStart, 0)
  ElseIf Vscroll1.Value = LastValue + 1 Then 'down arrow clicked: scroll up
    GridStart = GridStart + 1
    Call ScrollUp(0, 8)
    Call FillGrid(GridStart + 9, GridStart + 9, 9)
  Else
    If Vscroll1.Value = LastValue - 9 Then  'clicked above handle: page down
      GridStart = GridStart - 9
    ElseIf Vscroll1.Value = LastValue + 9 Then 'clicked below handle: page up
      GridStart = GridStart + 9
    Else                                       'moved handle
      GridStart = Vscroll1.Value
      If GridStart > LastRecord - 9 Then GridStart = LastRecord - 9
    End If
    Call FillGrid(GridStart, GridStart + 9, 0)
  End If
  LastValue = Vscroll1.Value
  T_Input.SetFocus
End Sub

Sub B_Find_Click ()
  If T_Input.Text = "" Then
    MsgBox "Nothing entered."
    Exit Sub
  End If
   
  u = LastRecord
  l = 1
  Do
    If u < l Then Exit Do
    i = (l + u) / 2
    Get 1, Pointer(i), Record
    Debug.Print l; u, T_Input.Text, Record.a1
    If T_Input.Text = RTrim$(LTrim$(Record.a1)) Then
      Exit Do
    ElseIf T_Input.Text > RTrim$(LTrim$(Record.a1)) Then
      l = i + 1
    Else
      u = i - 1
    End If
  Loop
   
  CurRec = i

  StartPt = i - 1
  If StartPt < 1 Then
    StartPt = 1
    MatchRow = 0
  ElseIf StartPt > LastRecord - 9 Then
    StartPt = LastRecord - 9
    MatchRow = LastRecord - StartPt
  Else
    MatchRow = 1
  End If
  
  IgnoreChange = -1
  If StartPt + 9 >= LastRecord Then
    Vscroll1.Value = LastRecord
  ElseIf StartPt = 1 Then
    Vscroll1.Value = 1
  Else
    Vscroll1.Value = StartPt
  End If
  IgnoreChange = 0

  LastValue = Vscroll1.Value
  
  Call FillGrid(StartPt, StartPt + 9, 0)

  GridStart = StartPt
  Grid1.Row = MatchRow
  Grid1.SelStartRow = MatchRow
  Grid1.SelEndRow = MatchRow
  Grid1.SelStartCol = 0
  Grid1.SelEndCol = 0

  T_Input.SetFocus
End Sub

Sub B_Insert_Click ()
  If LastRecord = FileSize Then
    MsgBox "Out of room."
    Exit Sub
  ElseIf T_Input.Text = "" Then
    MsgBox "Enter something in the Text Box."
    Exit Sub
  End If
  
  Call B_Find_Click
  Grid1.Row = MatchRow
  Grid1.Col = 0
   
  'If a match was not found, the contents of Grid.Row=MatchRow, .Col=0
  '  will be the closest match value.
  'Test to see if the new value is < or => the contents of that cell:
  
  If MatchRow < 5 Then
    If T_Input.Text < RTrim$(LTrim$(Grid1.Text)) Then
      Call ScrollDown(MatchRow + 1, 9)
      Grid1.Row = MatchRow
      CurRec = GridStart + MatchRow
    Else
      Call ScrollDown(MatchRow + 2, 9)
      Grid1.Row = MatchRow + 1
      CurRec = GridStart + MatchRow + 1
    End If
  Else
    If T_Input.Text < RTrim$(LTrim$(Grid1.Text)) Then
      Call ScrollUp(0, MatchRow - 2)
      Grid1.Row = MatchRow - 1
      CurRec = GridStart + MatchRow
    Else
      Call ScrollUp(0, MatchRow - 1)
      Grid1.Row = MatchRow
      CurRec = GridStart + MatchRow + 1
    End If
  End If
  
  Grid1.Col = 0
  Record.a1 = T_Input.Text
  Grid1.Text = T_Input.Text
  Grid1.Col = 1
  Record.a2 = ""
  Grid1.Text = ""
  Grid1.Col = 2
  Record.a3 = ""
  Grid1.Text = ""

  Call IncrLastRec
  If MatchRow > 5 Then GridStart = GridStart + 1
  For i = LastRecord To CurRec + 1 Step -1
    Pointer(i) = Pointer(i - 1)
  Next
  If NumDeleted > 0 Then
    Pointer(CurRec) = Deleted(NumDeleted)
    NumDeleted = NumDeleted - 1
  Else
    Pointer(CurRec) = LastRecord
  End If

  Get 1, Pointer(CurRec), Record

  T_Input.SetFocus

End Sub

Sub B_Quit_Click ()
 
  End

End Sub

Sub B_Sort_Click ()
  MousePointer = 11
  Ply = 1
  Bottom(1) = 1
  Topp(1) = LastRecord
 
  While Ply > 0
    If Bottom(Ply) >= Topp(Ply) Then
      Ply = Ply - 1
    Else
      i = Bottom(Ply) - 1
      j = Topp(Ply)
      Pt$ = GetRec$(j)
      While i < j
        i = i + 1
        j = j - 1
        While GetRec$(i) < Pt$
          i = i + 1
        Wend
        While GetRec$(j) > Pt$ And j > i
          j = j - 1
        Wend
        If i < j Then
          x = Pointer(i)
          Pointer(i) = Pointer(j)
          Pointer(j) = x
        End If
      Wend
      j = Topp(Ply)
      ii$ = GetRec$(i)
      If i <> j And ii$ > GetRec$(j) Then
        x = Pointer(i)
        Pointer(i) = Pointer(j)
        Pointer(j) = x
      End If
      If i - Bottom(Ply) < Topp(Ply) - i Then
        Bottom(Ply + 1) = Bottom(Ply)
        Topp(Ply + 1) = i - 1
        Bottom(Ply) = i + 1
      Else
        Topp(Ply + 1) = Topp(Ply)
        Bottom(Ply + 1) = i + 1
        Topp(Ply) = i - 1
      End If
      Ply = Ply + 1
    End If
  Wend
  MousePointer = 0

  Call FillGrid(1, 10, 0): IgnoreChange = -1
  Vscroll1.Value = 10: IgnoreChange = 0
  T_Input.SetFocus
End Sub

Sub T_Input_GotFocus ()
  T_Input.SelStart = 0
  T_Input.SelLength = 32767
End Sub
  

Sub Picture1_Click ()
  m$ = "Public (software) Library is the most extensive collection of pd/shareware available. "
  m$ = m$ + "We have a large collection of routines for all languages, including VB. "
  m$ = m$ + "For a catalog, call 800-242-4PsL or write PsL, P.O.Box 35705, Houston, TX 77235-5705."
  MsgBox m$
End Sub

Sub ScrollUp (StartRow, StopRow)
  For i = StartRow To StopRow
    Grid1.Row = i + 1
    Grid1.Col = 0
    x0$ = Grid1.Text
    Grid1.Col = 1
    x1$ = Grid1.Text
    Grid1.Col = 2
    x2$ = Grid1.Text
    Grid1.Row = i
    Grid1.Col = 0
    Grid1.Text = x0$
    Grid1.Col = 1
    Grid1.Text = x1$
    Grid1.Col = 2
    Grid1.Text = x2$
  Next
  
End Sub


Sub ScrollDown (StartRow, StopRow)
  For i = StopRow To StartRow Step -1
    Grid1.Row = i - 1
    Grid1.Col = 0
    x0$ = Grid1.Text
    Grid1.Col = 1
    x1$ = Grid1.Text
    Grid1.Col = 2
    x2$ = Grid1.Text
    Grid1.Row = i
    Grid1.Col = 0
    Grid1.Text = x0$
    Grid1.Col = 1
    Grid1.Text = x1$
    Grid1.Col = 2
    Grid1.Text = x2$
  Next
  
End Sub

Sub B_Del_Click ()
  If Grid1.CellSelected = 0 Then
    If Grid1.SelStartRow = Grid1.SelEndRow And Grid1.SelStartCol = Grid1.SelEndCol Then
      Grid1.Row = Grid1.SelStartRow
      Grid1.Col = Grid1.SelStartCol
    Else
      MsgBox "Cell not selected."
      Exit Sub
    End If
  End If
  
  r = GridStart + Grid1.Row  'file Record number
  
  x = MsgBox("Delete entire row?", 3)
  If x = 2 Then
    Exit Sub
  ElseIf x = 7 Then 'just delete cell, not the entire entry
    Grid1.Text = ""
    Grid1.Col = 0: Record.a1 = Grid1.Text
    Grid1.Col = 1: Record.a2 = Grid1.Text
    Grid1.Col = 2: Record.a3 = Grid1.Text
    Put 1, Pointer(r), Record
  Else
    NumDeleted = NumDeleted + 1
    Deleted(NumDeleted) = Pointer(r)
    For i = r To LastRecord
      Pointer(i) = Pointer(i + 1)
    Next
    Call DecrLastEl
    rw = Grid1.Row
    If GridStart + 9 < LastRecord Then
      Call ScrollUp(rw, 8)
      Call FillGrid(GridStart + 9, GridStart + 9, 9)
    Else
      GridStart = GridStart - 1
      Call ScrollDown(1, rw)
      Call FillGrid(GridStart, GridStart, 0)
    End If
  End If
  T_Input.SetFocus
  'Copyright 1991 Nelson Ford, Public (software) Library
End Sub

Sub DecrLastEl ()
  'takes care of all the ramifications of decreasing LastRecord
  LastRecord = LastRecord - 1
  IgnoreChange = -1
  Vscroll1.Max = LastRecord
  IgnoreChange = 0
  If LastValue > LastRecord Then LastValue = LastRecord
End Sub
   


Sub IncrLastRec ()
  'takes care of all the ramifications of increasing LastRecord
  LastRecord = LastRecord + 1
  IgnoreChange = -1
  Vscroll1.Max = LastRecord
  If Vscroll1.Value > Vscroll1.Max - 10 Then
    Vscroll1.Value = Vscroll1.Max
    LastValue = Vscroll1.Value
  End If
  IgnoreChange = 0
End Sub

Function GetRec (x) As String
  Get 1, Pointer(x), Record
  GetRec$ = Record.a1
End Function


Sub MakeSampleFile ()
  MsgBox "Creating file: C:\VB\TEST"
  Close : Open "c:\vb\test" For Random As 1 Len = 24
  For i = 1 To 5000
    j = 1
    Record.a1 = Str$(i) + "." + Mid$(Str$(j), 2): j = j + 1
    Record.a2 = Str$(i) + "." + Mid$(Str$(j), 2): j = j + 1
    Record.a3 = Str$(i) + "." + Mid$(Str$(j), 2)
    Put 1, i, Record
  Next
End Sub